perm filename COREL.SAI[CRE,BGB]1 blob
sn#036842 filedate 1973-04-25 generic text, type T, neo UTF8
00100 BEGIN "COREL"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 REQUIRE "TRIGER[SYS,BGB]" SOURCE_FILE;
00400 SAFE INTEGER ARRAY MULT[0:'7777];
00500 α DATA DIMENSIONS;
00600 INTEGER R1,C1,R2,C2,PTR1,PTR2;
00700 INTEGER N1,M1,N2,M2,DN,DM,SIZ1,SIZ2,SIZ3,N2M1;
00800 α SUMMATIONS;
00900 INTEGER MX,MXX,MY,MYY,MY1,MYY1,MXY;
01000 α VARIANCE, STANDARD DEVIATION, AND RESULTS;
01100 REAL VX,VY,SDX,SDY,COVAR,RMAX;
01200 REAL THRESHOLD,RADIUS,MAXRAD,AVGRAD;
01300 INTEGER NCNT;
01400 INTEGER II,JJ;
01500 α LOOP INDICES;
01600 INTEGER I,J,K;
01700 INTEGER TIME1,TIME2;
01800 INTEGER FLG,FLG1,FLG2,FLG3;
01900 STRING STR,PROBE;
02000 α UPPER SEGMENT DEFINITIONS;
02100 DEFINE CALLI = "'047000000000";
02200 DEFINE CORE2 = "'400015";
02300 DEFINE ATTSEG = "'400016";
02400 DEFINE DETSEG = "'400017";
02500 DEFINE SEGSIZ = "'400022";
02600 DEFINE SETNM2 = "'400036";
02700 DEFINE NAMEIN = "'400043";
02800 DEFINE _PROBE = "'126062574245";
02900 DEFINE _TARGT = "'126441624764";
03000 DEFINE _RSULT = "'126263655464";
03100 DEFINE SAISG2 = "'634151634722";
03200 DEFINE HALT = "JRST 4,";
00100 α MAIL DEFINITIONS;
00200 INTEGER CALLER,LTRPTR;
00300 SAFE INTEGER ARRAY LETTER[0:31];
00400 DEFINE MAIL = "'710000000000";
00500 α INIT MULTIPLICATION TABLE;
00600 FOR I←0 STEP 1 UNTIL 63 DO
00700 FOR J←0 STEP 1 UNTIL 63 DO
00800 MULT[(I LSH 6)LOR J]←I*J;
00900 LTRPTR ← BBPP(36,LETTER[0],35);
01000 CALLER ← 0;
01100 OUTCHR("*");
01200 α COMMAND MAIL LISTEN LOOP;
01300 WHILE TRUE DO
01400 BEGIN "FOREVER"
01500 LABEL EOL;
01600
01700 START_CODE "MAIL"
01800 LABEL L1,L2;
01900 α SEND RESULTS TO THE CALLER, (IF HE EXISTS);
02000 SKIPN CALLER;
02100 JRST L1;
02200 MAIL CALLER;
02300 JRST EOL;
02400 α WAIT FOR A COMMAND LETTER;
02500 L1: MOVE LETTER;
02600 HRRM L2;
02700 L2: MAIL 1,;
02800 END "MAIL";
00100 α ARGUMENT FETCH;
00200 BEGIN "ARGUMENTS"
00300 CALLER ← LETTER[0];
00400 FLG1 ← LETTER[1];
00500 FLG2 ← LETTER[2];
00600 FLG3 ← LETTER[3];
00700 R1 ← LETTER[4]; R2 ← LETTER[8];
00800 C1 ← LETTER[5]; C2 ← LETTER[9];
00900 M1 ← LETTER[6]; M2 ← LETTER[10];
01000 N1 ← LETTER[7]; N2 ← LETTER[11];
01100 START_CODE
01200 MOVE 11,LETTER;
01300 MOVE 11,12(11);
01400 MOVEM 11,THRESHOLD;
01500 SETZM NCNT;
01600 END;
01700 II←JJ←RMAX←-1;
01800
01900 α KILL UPPER SEGMENTS AND RETURN;
02000 IF FLG3 THEN
02100 START_CODE
02200 SETZ 1,;
02300 CALLI DETSEG;
02400 MOVE [_PROBE];
02500 CALLI ATTSEG; JFCL;
02600 CALLI 1, CORE2; JFCL;
02700 MOVE [_TARGT];
02800 CALLI ATTSEG; JFCL;
02900 CALLI 1, CORE2; JFCL;
03000 MOVE [_RSULT];
03100 CALLI ATTSEG; JFCL;
03200 CALLI 1, CORE2; JFCL;
03300 MOVE [SAISG2];
03400 CALLI ATTSEG; JFCL;
03500 JRST EOL;
03600 END;
03700 SIZ1 ← M1*N1;
03800 SIZ2 ← M2*N2;
03900 N2M1 ← N2*M1;
04000 DN ← N2 - N1;
04100 DM ← M2 - M1;
04200 SIZ3 ← (DN+1)*(DM+1);
04300 IF DN≤0 ∨ DM≤0 THEN GO EOL;
04400 END "ARGUMENTS";
00100 α MAKE SUB WINDOW BYTE POINTERS;
00200 α WRD ← R*48 + C%6 + '400001;
00300 α BRI ← 36 - (C MOD 6)*6;
00400
00500
00600 START_CODE
00700 MOVE 0, C1;
00800 IDIVI 0, 6;
00900 IMULI 1, 6;
01000 MOVEI 2, 36;
01100 SUB 2, 1;
01200 ANDI 2, '77;
01300 ROT 2, -6;
01400 TLO 2, '600;
01500 MOVE 1, R1;
01600 IMULI 1, 48;
01700 ADDI 1, '400001;
01800 ADD 1, 0;
01900 HRR 2, 1;
02000 MOVEM 2, PTR1;
02100 END;
02200
02300 START_CODE
02400 MOVE 0, C2;
02500 IDIVI 0, 6;
02600 IMULI 1, 6;
02700 MOVEI 2, 36;
02800 SUB 2, 1;
02900 ANDI 2, '77;
03000 ROT 2, -6;
03100 TLO 2, '600;
03200 MOVE 1, R2;
03300 IMULI 1, 48;
03400 ADDI 1, '400001;
03500 ADD 1, 0;
03600 HRR 2, 1;
03700 MOVEM 2, PTR2;
03800 END;
00100 BEGIN "BUFFER BLK"
00200 INTEGER ARRAY X[1:SIZ1];
00300 INTEGER ARRAY Y[1:SIZ2];
00400 REAL ARRAY R[0:DM,0:DN];
00500 α UNPACK A SUB WINDOW FROM THE UPPER SEGMENT;
00600 PROCEDURE UNPACKER;
00700 START_CODE
00800 DEFINE PTR = "1";
00900 DEFINE MCNT = "2";
01000 DEFINE N = "3";
01100 DEFINE NCNT = "4";
01200 DEFINE OUTPTR = "5";
01300 DEFINE INPTR = "6";
01400 LABEL L1,L2;
01500 MOVE OUTPTR, 0;
01600 L1: MOVE NCNT, N;
01700 MOVE INPTR, PTR;
01800 L2: ILDB INPTR;
01900 MOVEM (OUTPTR);
02000 AOS OUTPTR;
02100 SOJG NCNT, L2;
02200 ADDI PTR, 48;
02300 SOJG MCNT, L1;
02400 END;
00100 START_CODE "GET SUBWINDOWS"
00200 LABEL L;
00300 CALLI 1, DETSEG;
00400 α PROBE WINDOW;
00500 MOVE [_PROBE];
00600 CALLI ATTSEG;
00700 JRST EOL;
00800 MOVE 0, X;
00900 MOVE 1, PTR1;
01000 MOVE 2, M1;
01100 MOVE 3, N1;
01200 PUSHJ 15, UNPACKER;
01300 SKIPN FLG1; α AUTO/CROSS FLAG;
01400 JRST L;
01500 CALLI 1, DETSEG;
01600 α TAGET WINDOW;
01700 MOVE [_TARGT];
01800 CALLI ATTSEG;
01900 JRST EOL;
02000 L: MOVE 0, Y;
02100 MOVE 1, PTR2;
02200 MOVE 2, M2;
02300 MOVE 3, N2;
02400 PUSHJ 15, UNPACKER;
02500 CALLI 1, DETSEG;
02600 α RETURN TO SAIL;
02700 MOVE [SAISG2];
02800 CALLI ATTSEG;
02900 JRST EOL;
03000 END "GET SUBWINDOWS";
00100 α ACCUMULATE SUMMATION X AND SUMMATION X SQUARED;
00200 MXX ← MX ← 0;
00300 FOR K←1 STEP 1 UNTIL SIZ1 DO
00400 BEGIN
00500 MX ← MX + X[K];
00600 MXX ← MXX + X[K]↑2;
00700 X[K] ← X[K] LSH 6;
00800 END;
00900 VX ← MXX/SIZ1 - (MX/SIZ1)↑2;
01000 SDX ← SQRT(VX);
01100 α ACCUMULATE SUMMATION Y AND SUMMATION Y SQUARED;
01200 MY ← MYY ← 0;
01300 FOR I←0 STEP N2 UNTIL (M1-1)*N2 DO
01400 FOR J←1 STEP 1 UNTIL N1 DO
01500 BEGIN
01600 MY ← MY + Y[I+J];
01700 MYY ← MYY+ Y[I+J]↑2;
01800 END;
01900 MY1 ← MY;
02000 MYY1 ← MYY;
00100 α INIT Y SQUARED TABLE;
00200 START_CODE
00300 LABEL L1,L2;
00400 MOVE 13,SIZ2;
00500 MOVE 12,Y;
00600 SOS 12;
00700 HRRM 12,L1;
00800 HRRM 12,L2;
00900 L1: MOVE 11,(13);
01000 IMUL 11,11;
01100 L2: HRLM 11,(13);
01200 SOJG 13,L1;
01300 END;
00100 α INIT BEST ANSWER VARIABLE;
00200 RMAX ← -10;
00300 α START THE CLOCKS;
00400 TIME1 ← CALL(0,"RUNTIM");
00500 TIME2 ← CALL(0,"MSTIME");
00600
00700 α MOVE THE SMALLER WINDOW THROUGH ALL POSSIBLE POSITIONS IN THE BIGGER ONE;
00800 FOR J←0 STEP 1 UNTIL DN DO
00900 BEGIN "COLUMN OFFSET"
01000 FOR I←0 STEP 1 UNTIL DM DO
01100 BEGIN "ROW OFFSET"
00100 START_CODE "CROSS MULTIPLY"
00200 LABEL L0,EXIT;
00300 α NAME AFEW ACCUMULATORS;
00400 DEFINE SUM="0", XY="1", R ="2", C ="3",
00500 L1 ="4", L2 ="5", YPTR="6", XPTR="7";
00600 α LOAD THE CACHE;
00700 HRLI L0; α FROM HERE;
00800 HRRI L1; α TO THERE;
00900 BLT 13; α TO LAST;
01000 α INITIALIZATION OF INNER LOOP;
01100 HRR 4,N1; α COLUMN COUNT;
01200 HRR 11,DN; α YPTR INCREMENT;
01300 MOVE I;
01400 IMUL N2;
01500 ADD J;
01600 ADD Y;
01700 HRR YPTR,; α INIT YPTR;
01800 HRR XPTR,X;
01900 SOS XPTR; α INITIAL XPTR ADDRESS;
02000 HRR 8,MULT;
02100 MOVE R,M1; α INITIAL ROW COUNT;
02200 SETZ SUM,;
02300 JRST L1; α ENTER THE LOOP;
02400 α INNER LOOP ACCUMULATOR CODE;
02500 L0: MOVEI C,N1; α ADDRESS MODIFIED BY INITIALIZATION;
02600 AOS XPTR;
02700 HRRZ XY, ; α ADDRESS MODIFIED BY INIT AND THE LOOP;
02800 IOR XY, ; α ADDRESS MODIFIED BY INIT AND THE LOOP;
02900 ADD MULT(XY); α MULTIPLICATION BY TABLE LOOKUP;
03000 AOS YPTR;
03100 SOJG C,L2; α DECREMENT COLUMN COUNTER;
03200 ADDI YPTR,DN; α ADDRESS MODIFIED BY INITIALIZATION;
03300 SOJG R,L1; α DECREMENT ROW COUNTER;
03400 JRST EXIT; α END OF INNER LOOP;
03500 α EXIT THE INNER LOOP;
03600 EXIT: MOVEM SUM,MXY;
03700
03800 END "CROSS MULTIPLY";
00100 α COMPUTE VARIANCE AND COVARIANCE;
00200 VY ← (MYY/SIZ1) - (MY/SIZ1)↑2;
00300 COVAR ← (MXY/SIZ1) - (MX/SIZ1)*(MY/SIZ1);
00400 SDY ← SQRT(VY);
00500 R[I,J] ← COVAR/(SDX*SDY);
00600 IF R[I,J]>RMAX THEN
00700 RMAX ← R[II←I,JJ←J];
00800 IF R[I,J]>THRESHOLD THEN NCNT←NCNT+1;
00100 α MOVE THE WINDOW DOWN A ROW IN THE Y ARRAY;
00200 START_CODE "DOWN A ROW"
00300 DEFINE PTR="1",YAC="2",YYAC="3";
00400 LABEL L1,EXIT,Q;
00500 α LOAD THE CACHE;
00600 HRLI L1; α FROM;
00700 HRRI 4; α TO;
00800 BLT 13; α LAST;
00900 α INITIALIZATION;
01000 MOVE I; α ROW OFFSET;
01100 IMUL N2;
01200 ADD J; α COL OFFSET;
01300 ADD Y;
01400 Q: SOS;
01500 HRR 4,; α Y OLD PTR;
01600 HRR 6,;
01700 ADD N2M1;
01800 HRR 8,; α Y NEW PTR;
01900 HRR 10,;
02000 MOVE PTR,N1; α COLUMN COUNT;
02100 SETZB YAC,YYAC;
02200 JRST 4;
02300 α INNER LOOP;
02400 L1:
02500 HRRZ (PTR); α OLD ROW;
02600 SUB YAC,;
02700 HLRZ (PTR); α OLD ROW;
02800 SUB YYAC,;
02900 HRRZ (PTR); α NEW ROW;
03000 ADD YAC,;
03100 HLRZ (PTR); α NEW ROW;
03200 ADD YYAC,;
03300 SOJG PTR,4;
03400 JRST EXIT;
03500
03600 EXIT: ADDM YAC,MY; α UPDATE THE SUMMATIONS;
03700 ADDM YYAC,MYY;
03800 END "DOWN A ROW";
03900 END "ROW OFFSET";
00100 α MOVE THE WINDOW RIGHT A COLUMN IN THE Y ARRAY;
00200 START_CODE "RIGHT A COLUMN"
00300 INTEGER TMP;
00400 DEFINE PTR="1",YAC="2",YYAC="3";
00500 LABEL L1,EXIT;
00600 MOVEM 14,TMP;
00700 α LOAD THE CACHE;
00800 HRLI L1; α FROM;
00900 HRRI 4; α TO;
01000 BLT 14; α LAST;
01100 α INITIALIZATION;
01200 MOVE Y; α THAT IS Y[1];
01300 SUB N2;
01400 ADD J; α COL OFFSET;
01500 HRR 4,; α Y OLD PTR;
01600 HRR 6,;
01700 ADD N1;
01800 HRR 8,; α Y NEW PTR;
01900 HRR 10,;
02000 MOVE PTR,N2M1; α ROW COUNT IN UNITS OF M2;
02100 SETZB YAC,YYAC;
02200 HRR 12,N2;
02300 JRST 4;
02400 α INNER LOOP;
02500 L1:
02600 HRRZ (PTR); α OLD COLUMN;
02700 SUB YAC,;
02800 HLRZ (PTR); α OLD COLUMN;
02900 SUB YYAC,;
03000 HRRZ (PTR); α NEW COLUMN;
03100 ADD YAC,;
03200 HLRZ (PTR); α NEW COLUMN;
03300 ADD YYAC,;
03400 SUBI PTR, ;
03500 JUMPG PTR,4;
03600 JRST EXIT;
03700
03800 EXIT: ADDB YAC,MY1; α UPDATE MY1 & MYY1;
03900 ADDB YYAC,MYY1;
04000 MOVEM YAC,MY; α RESET MY & MYY;
04100 MOVEM YYAC,MYY;
04200 MOVE 14,TMP;
04300 END "RIGHT A COLUMN";
04400 END "COLUMN OFFSET";
00100 α FIND THE AVERAGE AND MAXIMUM RADIUS OF THE POINTS ABOVE THRESHOLD,
00200 α ABOUT THE RMAX POINT;
00300 MAXRAD←AVGRAD←0;
00400 FOR I←0 STEP 1 UNTIL DM DO
00500 FOR J←0 STEP 1 UNTIL DN DO
00600 IF R[I,J]≥THRESHOLD THEN
00700 BEGIN
00800 RADIUS ← SQRT( (II-I)↑2 + (JJ-J)↑2 );
00900 MAXRAD ← MAXRAD MAX RADIUS;
01000 AVGRAD ← AVGRAD + RADIUS;
01100 END;
01200 AVGRAD ← AVGRAD/NCNT;
01300 TIME1 ← CALL(0,"RUNTIM") - TIME1;
01400 TIME2 ← CALL(0,"MSTIME") - TIME2;
01500
01600 α PLACE RESULTS IN THE LETTER;
01700 LETTER[13] ← II;
01800 LETTER[14] ← JJ;
01900 LETTER[16] ← NCNT;
02000 LETTER[19] ← TIME1;
02100 LETTER[20] ← TIME2;
02200 START_CODE
02300 MOVE 1, LETTER;
02400 MOVE RMAX;
02500 MOVEM 15(1);
02600 MOVE MAXRAD;
02700 MOVEM 17(1);
02800 MOVE AVGRAD;
02900 MOVEM 18(1);
03000 END;
00100 α CREATE RESULT SEGMENT WHEN CALLED FOR;
00200 IF FLG2 THEN
00300 START_CODE "RESULTS"
00400 SETZ 1,;
00500 CALLI DETSEG;
00600 MOVE [_RSULT];
00700 CALLI ATTSEG; SKIPA;
00800 SKIPA;
00900 CALLI 1,CORE2; JFCL;
01000 MOVE 1,SIZ3;
01100 CALLI 1,CORE2; JFCL;
01200 HRLZ R;
01300 HRRI '400001;
01400 BLT '400001(1);
01500 MOVE [_RSULT];
01600 CALLI SETNM2; JFCL;
01700 CALLI 1,DETSEG;
01800 MOVE [SAISG2];
01900 CALLI ATTSEG; JFCL;
02000 END "RESULTS";
02100
02200 END "BUFFER BLK";
02300 EOL:
02400 END "FOREVER";
02500 END "COREL";